home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE07 / INTERNAL / TESTFORM.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1996-01-28  |  3.1 KB  |  118 lines
  1. unit Testform;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, DOSInfo, OvcBase, OvcEF, OvcSF, OvcTCSim,
  8.   ExtCtrls, Tabs;
  9.  
  10. type
  11.   TForm1 = class(TForm)
  12.     TabSet1: TTabSet;
  13.     Notebook1: TNotebook;
  14.     GroupBox1: TGroupBox;
  15.     Label1: TLabel;
  16.     Label2: TLabel;
  17.     Label3: TLabel;
  18.     FlopTypeB: TLabel;
  19.     FlopTypeA: TLabel;
  20.     FlopCount: TLabel;
  21.     GroupBox2: TGroupBox;
  22.     Label4: TLabel;
  23.     Label5: TLabel;
  24.     DriveList: TComboBox;
  25.     TheLabel: TEdit;
  26.     GroupBox3: TGroupBox;
  27.     Label6: TLabel;
  28.     Label7: TLabel;
  29.     DriveList2: TComboBox;
  30.     TheSerialNum: TLabel;
  31.     procedure FormCreate(Sender: TObject);
  32.     procedure DriveListChange(Sender: TObject);
  33.     procedure FormKeyPress(Sender: TObject; var Key: Char);
  34.     procedure TabSet1Change(Sender: TObject; NewTab: Integer;
  35.       var AllowChange: Boolean);
  36.     procedure DriveList2Change(Sender: TObject);
  37.   private
  38.     { Private declarations }
  39.   public
  40.     { Public declarations }
  41.   end;
  42.  
  43. var
  44.   Form1: TForm1;
  45.  
  46. implementation
  47.  
  48. {$R *.DFM}
  49.  
  50. procedure TForm1.FormCreate(Sender: TObject);
  51. var
  52.     i: Char;
  53. begin
  54.     TabSet1.Tabs := NoteBook1.Pages;
  55.  
  56.     { Set up the various labels }
  57.     FlopCount.Caption := IntToStr (GetFloppyDriveCount);
  58.     FlopTypeA.Caption := IntToStr (GetFloppyDriveType (0)) + ' KBytes';
  59.     FlopTypeB.Caption := IntToStr (GetFloppyDriveType (1)) + ' KBytes';
  60.  
  61.     for i := 'C' to 'Z' do
  62.         if GetDriveType (Ord (i) - Ord ('A')) = Drive_Fixed then
  63.         begin
  64.             DriveList.Items.Add (Format ('Drive %s:', [i]));
  65.             DriveList2.Items.Add (Format ('Drive %s:', [i]));
  66.         end;
  67.  
  68.     DriveList.ItemIndex := 0;
  69.     DriveList2.ItemIndex := 0;
  70.     DriveListChange (Sender);
  71.     DriveList2Change (Sender);
  72. end;
  73.  
  74. procedure TForm1.DriveListChange(Sender: TObject);
  75. var
  76.     s: String;
  77. begin
  78.     s := Copy (DriveList.Items [DriveList.ItemIndex], 7, 1);
  79.     TheLabel.Text := GetDriveLabel (Ord (s[1]) - $40);
  80. end;
  81.  
  82. procedure TForm1.DriveList2Change(Sender: TObject);
  83. var
  84.     s: String;
  85.     snum: LongInt;
  86. begin
  87.     s := Copy (DriveList2.Items [DriveList2.ItemIndex], 7, 1);
  88.     snum := GetSerialNumber (Ord (s[1]) - $40);
  89.     TheSerialNum.Caption := Format ('%.4x-%.4x', [HiWord (snum), LoWord (snum)]);
  90. end;
  91.  
  92. procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
  93. var
  94.     s: String;
  95.     drive: Integer;
  96. begin
  97.     if Ord (Key) = vk_Return then
  98.     begin
  99.         Key := #0;
  100.         s := Copy (DriveList.Items [DriveList.ItemIndex], 7, 1);
  101.         drive := Ord (s[1]) - $40;
  102.         if (TheLabel.Text = '') and (GetDriveLabel (drive) <> '') then
  103.         begin
  104.             if MessageDlg (Format ('Remove drive label for drive %s: ?', [s [1]]),
  105.                            mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  106.                 SetDriveLabel (drive, '');
  107.         end
  108.         else SetDriveLabel (drive, TheLabel.Text);
  109.     end;
  110. end;
  111.  
  112. procedure TForm1.TabSet1Change(Sender: TObject; NewTab: Integer; var AllowChange: Boolean);
  113. begin
  114.     NoteBook1.PageIndex := NewTab;
  115. end;
  116.  
  117. end.
  118.